home *** CD-ROM | disk | FTP | other *** search
/ CU Amiga Super CD-ROM 27 / CU Amiga Magazine's Super CD-ROM 27 (1998)(EMAP Images)(GB)[!][issue 1998-10].iso / CUCD / Programming / JForth / JTools / Janim / ytable.f < prev   
Encoding:
FORTH Source  |  1991-11-18  |  2.6 KB  |  129 lines
  1. \  YTABLE allocator for JForth ANIM-5 support
  2. \
  3. \ YTABLEs are fast multiplication tables used to speed up
  4. \ decoding of packed ANIMs.
  5. \
  6. \ Author: Martin Kees 10/13/90
  7. \ Copyright 1990 Martin Kees
  8. \ Freely Distributable to the JForth Community
  9. \
  10. \ MOD: MCK 11/8/90 cleanup ALLOC.YTABLE with no recurse
  11. \ MOD: MCK 11/8/90 fixed FIND.YTABLE logic/stack error
  12. \ MOD: MCK 11/8/90 used variable instead of v:
  13. \ MOD: MCK 1/11/91 NO need for ytables with more than 128 entries!
  14. \                  Since Skips are a max of 127 lines
  15. \ MOD: MCK 1/11/91 uses larger table if already allocated
  16. \ MOD: MCK 2/11/91 anim.error added to anim.init
  17. \                  other errors reflected in flag returned on stack
  18. \ 00001 PLB 11/16/91 New error handling system,
  19. \                    renamed ALLOC.ANIM-YTABLE to ALLOC.YTABLE.TRACKER
  20. anew TASK-YTABLE
  21.  
  22. variable ANIM-YTABLE
  23. 128 constant MAX_YTABS  \ Increase this if you run out of YTABLES
  24.  
  25. : ALLOC.YTABLE.TRACKER ( -- tracker )
  26.     anim-ytable @ ?dup
  27.     IF
  28.         ." ANIM seems to be intitialized already."  cr
  29.         \ non-fatal error
  30.     ELSE
  31.         [ MEMF_PUBLIC MEMF_CLEAR | ] literal
  32.         Max_ytabs cells allocblock
  33.         dup anim-ytable ! 0=
  34.         IF
  35.             ." No memory for Ytables!" cr
  36.         THEN
  37.         anim-ytable @
  38.     THEN
  39. ;
  40.  
  41. : CREATE.YTABLE { byteoffset linesize | ytab --- ytab | 0 }
  42.     [ MEMF_PUBLIC MEMF_CLEAR | ] literal
  43.     linesize 128 min dup -> linesize
  44.     2* allocblock -> ytab
  45.     ytab
  46.     IF 0
  47. \ generate multiplication table
  48.         linesize 0
  49.         DO dup ytab i 2* + w!
  50.             byteoffset +
  51.         LOOP
  52.         drop
  53.     THEN
  54.     ytab
  55. ;
  56.  
  57. : FIND.YTABLE { byteoffset linesize | ytab --- ytab | 0 , find match }
  58.     0 -> ytab
  59.     anim-ytable @
  60.     dup freebyte 0
  61.     DO
  62.         dup i + @ ?dup
  63.         IF
  64.             dup @ byteoffset =
  65.             IF
  66.                 dup sizemem 2/ linesize 128 min >=
  67.                 IF -> ytab
  68.                     LEAVE
  69.                 THEN
  70.             THEN
  71.             drop
  72.         THEN
  73.         cell
  74.     +LOOP
  75.     drop
  76.     ytab
  77. ;
  78.  
  79. : ADD.YTABLE.USER  ( ytable -- , increment user counter )
  80.     1 swap freebytea +!
  81. ;
  82.  
  83. : ALLOC.YTABLE { byteoffset linesize | ytable -- ytable | 0 }
  84.     0 -> ytable
  85.     anim-ytable @ 0=
  86.     IF alloc.ytable.tracker 0= ?goto.error
  87.     THEN
  88. \
  89. \ Try to find a matching table
  90.     byteoffset linesize find.ytable dup -> ytable
  91.     IF ytable add.ytable.user
  92.     ELSE
  93. \
  94. \ Is there room to keep track of another YTABLE ?
  95.         anim-ytable @ freebyte 4 /
  96.         Max_ytabs = \ are we full
  97.         IF 
  98.             ." ALLOC.YTABLE - exceeded MAX_YTABS!" cr
  99.             goto.error
  100.         ELSE
  101. \
  102. \ Create a new one.
  103.             byteoffset linesize create.ytable dup -> ytable
  104.             IF
  105.                 ytable anim-ytable @ push
  106.                 1 ytable freebytea !
  107.             ELSE
  108.                 ." ALLOC.YTABLE - insufficient memory!" cr
  109.                 goto.error
  110.             THEN
  111.         THEN
  112.     THEN
  113.     ytable
  114.     exit
  115. ERROR:
  116.     0
  117. ;
  118.  
  119. : FREE.YTABLE ( ytable --- )
  120.     >r
  121.     -1 r@ freebytea +!
  122.     r@ freebytea @
  123.     IF rdrop
  124.     ELSE r@ freeblock
  125.         r> anim-ytable -stack
  126.     THEN
  127. ;
  128.  
  129.